home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / sound / sound.frm < prev    next >
Text File  |  1994-10-21  |  2KB  |  101 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   2550
  5.    ClientLeft      =   3690
  6.    ClientTop       =   2370
  7.    ClientWidth     =   2370
  8.    Height          =   2955
  9.    Left            =   3630
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2550
  12.    ScaleWidth      =   2370
  13.    Top             =   2025
  14.    Width           =   2490
  15.    Begin CommandButton Command3 
  16.       Caption         =   "Stop Sound/Siren"
  17.       Height          =   615
  18.       Left            =   240
  19.       TabIndex        =   2
  20.       Top             =   1680
  21.       Width           =   1815
  22.    End
  23.    Begin CommandButton Command2 
  24.       Caption         =   "Play Siren"
  25.       Height          =   615
  26.       Left            =   240
  27.       TabIndex        =   1
  28.       Top             =   840
  29.       Width           =   1815
  30.    End
  31.    Begin CommandButton Command1 
  32.       Caption         =   "Play Sound"
  33.       Height          =   615
  34.       Left            =   240
  35.       TabIndex        =   0
  36.       Top             =   120
  37.       Width           =   1815
  38.    End
  39. End
  40. Option Explicit
  41. DefInt A-Z
  42. Dim SoundStat%
  43.  
  44. Sub Command1_Click ()
  45. PlaySounds
  46. End Sub
  47.  
  48. Sub Command2_Click ()
  49. PlaySiren
  50. End Sub
  51.  
  52. Sub Command3_Click ()
  53. Dim x%
  54. If SoundStat% <> 0 Then
  55.     x% = StopSound()
  56.     CloseSound
  57.     SoundStat% = 0
  58. End If
  59.  
  60.  
  61.  
  62. End Sub
  63.  
  64. Sub PlaySiren ()
  65. Dim SoundVal&, Freq%, Duration%, OffSet%, x%
  66.  
  67. If SoundStat% = 0 Then SoundStat% = OpenSound%()
  68.  
  69. x% = SetVoiceQueueSize(1, 1000)
  70. x% = SetVoiceAccent(1, 120, 255, 1, 0)
  71. Freq% = 800
  72. Duration% = 10
  73. OffSet% = 5
  74.  
  75. Do
  76.     SoundVal& = CLng(Freq%) * &H1000
  77.     x% = SetVoiceSound%(1, SoundVal&, Duration%)
  78.     Freq% = Freq% + OffSet%
  79.     If Freq% >= 1000 Then OffSet% = -5
  80.     If Freq% <= 800 Then OffSet% = 5
  81. Loop While x% = 0
  82.  
  83. x% = StartSound%()
  84. End Sub
  85.  
  86. Sub PlaySounds ()
  87.     Dim Note%, Duration%, x%
  88.  
  89.     If SoundStat% = 0 Then SoundStat% = OpenSound%()
  90.  
  91.     x% = SetVoiceQueueSize(1, 1024)
  92.     Do
  93.         Note% = Int(Rnd * 84 + 1)
  94.         Duration% = 2 ^ Int(Rnd * 4)
  95.         x% = SetVoiceNote%(1, Note%, Duration%, 1)
  96.     Loop While x% = 0
  97.  
  98.     x% = StartSound%()
  99. End Sub
  100.  
  101.